00100	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200	C *** READS DATA FROM CLEF0, BDR40,BDI40, ETC.
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD
00600		COMMON /DL/X22,SAVER,NAME/RRJJ/RJJ2,RJJ(20) /FONT/JFONT
00700		DIMENSION RPOS(2,40),LST(13),DP(-3/4),LX(14),LY(6),R(8,100)
00800		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
00900	C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
01000		COMMON /STF/RSTFAC(-3/4),RSTJ2 /POSI/STFF(-3/4),JJ2,POS 
01100		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01200		1/ALF/INP(72),ML /UPDWN/ RL,UD
01300		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01400		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01500		COMMON/XRN/RN(4000)/DPY/ST(4000),WDS(250),MEDIT,IGO	
01600		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01700		1,(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(IT,LY(6))
01900		1,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(LX(8),IL),(I3,INP(3))
02000		1,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(RSET4,RN(3920)),(R,RN(3001))
02100		1 ,(TOP,ST(3999)),(BOT,ST(4000)),(R8,RJQ(6)),(RJ3,RJJ(1))
02200		1 ,(R9,RJQ(7)),(IBEAM,RN(3000)),(IR,LX(11)),(IU,LX(13))
02300		1,(RPOS(1,1),RN(3921)),(ST2,ST(2)),(IBL,LY(1)),(R13,RJQ(11))
02400		1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
02500		1,(LX(2),ICC),(LX(5),IG),(LX(3),ID),(LX(14),IXX),(IPOS,POS)
02600		1,(RX3,RJQ(20)),(IA,LX(1)),(RMODE2,RN(3918))
02700		DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02800		1 ,LST/'NOTE','REST','CLEF','LINE','SLUR',
02900		1 'BEAM','TRILL','STAFF','MISC','NUMB','WORD','KSIG','METER'/
03000		1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
03100		1 'S','U','X'/
03200		1,LY/' ','A','B','D','E','T'/, DIS/1.0/
03300	
03310		CALL SEGFIX
03355	C  FOR UPPER SEGMENTS USED BY MORE THAN 1 JOB (SEGFIX.FAI[TVR])
03400		LCEN=0
03500		MCEN=0
03600	CP	TOP2=-999
03700	C  IF -1, THEN TRUE OUTLINES OF FONTS ARE DISPLAYED.
03800		I1=0
03900	CP	DIS=1.
04000	CP	RHT=1.
04100	C  FOR 'FILLER' ON CRT.
04200	2	CALL DPYSET(1,ST,4000)
04300		CALL HYDPOG(1)
04400		CALL TYPLOC(-180,-511)
04500		CALL DPYBRT(5)
04600		DO 299 K=1,I
04700	CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
04800	299	RN(K)=0
04900		JFONT=0
05000		RSET4=999
05100		QUICK=0
05200		UD=1
05300		RL=1
05400		FSCN=IL
05500		RPOS(1,1)=0
05600	CP	PLOTIT=0
05700		RSZ=.845
05800	CP	TOP=-999
05900	CP	BOT=999
06000		X22=0
06100		JCEN=0
06200		KCEN=0
06300		PLT=0
06400		PWDS(1)=1
06500		EDX=-1
06600		RN(2)=0
06700	C  FOR RESTART.  AVOIDS STAFF CODE NUM.
06800		SAVER=7
06900		DO 1402 K=-3,4
07000	1402	RSTFAC(K)=1.
07100		REDIT=999.
07200		M=1
07300		ITEM=0
07400		ZERO=-1
07500		WDS(1)=4
07600	C  DATA IN DPY ARRAY STARTS AT WD.4!
07700		I=1
07800	1100	SCORE=-1
07900	58	IGO=-1
08000		IF(I1.NE.'R')GO TO 5505
08100		CALL FORMAT(NAME)
08200		IF(NAME.NE.IBL)GO TO 1221
08300	C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
08400		GO TO 5505
08500	
08600	11	CALL NOTWRT
08700	CP57	IF(PLT)GO TO 6120
08800	57	IF(M.GT.I)GO TO 571
08900		IF(IGO)CALL DPYOUT(1)
09000	571	ITEM=ITEM+1
09100		IF(ITEM.LT.250)GO TO 17
09200		TYPE 170,ITEM
09300		I=PWDS(250)
09400		ITEM=249
09500		ST2=WDS(250)
09600		CALL DPYOUT(1)
09700		GO TO 1100
09800	170	FORMAT(2(' **** TOO MANY ITEMS ',I3,'/249'/))
09900	17	IF(IGO.GT.0)GO TO 20000
10000		K=ST2
10100		IF(X22.EQ.0)GO TO 20000
10200		CALL BOX(IBOX,RBOX,STFF)
10300		ST2=K
10400	20000	WDS(ITEM+1)=ST2
10500		IF(EDX.EQ.-1)GO TO 1571
10600		IF(M.LT.I)GO TO 6120
10700	CP1571	IF(PLOTIT.EQ.-2)GO TO 2311
10800	C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
10900	1571	PWDS(ITEM+1)=I
11000		PLT=0
11100		IF(IGO.NE.0)GO TO 55
11200		CALL DPYOUT(1)
11300		IF(SCORE.EQ.0)GO TO 9532
11400	C  GO GET MORE FROM SCX.
11500		IGO=-1
11600	
11700	55	IF(SCORE.EQ.0)GO TO 553
11800	5505	SVST=ST2
11900	C CATCHES TYPO WITH 'C'
12000		K=ITEM+1
12100		IF(X22.EQ.0)GO TO 5503
12200		K=X22
12300		L=RN(MEDIT+1)
12400		IF(L.EQ.13)L=11
12500	CC	IF(L.EQ.10)L=9
12600	CC	IF(L.GE.16.AND.L.LE.18)L=L-5
12700		IF(L.GE.11)L=L-1
12800		IF(L.GE.15)L=L-4
12900	CC	IF(L.EQ.20)L=12
13000	5502	IF(QUICK)GO TO 5911
13100		TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
13200		IF(YED.LT.2)GO TO 59
13300	CP	IF(YED.LT.2)GO TO 5504
13400	C   YED IS SET AT 426
13500		DO 5501 L=4,YED+2
13600	5501	TYPE 4271,L,RN(MEDIT+L)
13700		GO TO 59
13800	
14700	5919	FORMAT(' ;=LFT :=RT (=UP )=DN /=HALF *=*2'/)
14800	591	QUICK=-1
14900		TYPE 5919
15000	5911	CALL FSCAN
15100	C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )=↓ /=HALF *=*2 X=X C=C OTHERS=CR
15200		GO TO 1591
15300		GO TO 2591
15400		GO TO 3591
15500		GO TO 4591
15600		GO TO 5913
15700		GO TO 6591
15800		GO TO 7591
15900		GO TO 5912
16000		I1=0
16100	5591	QUICK=0
16200		GO TO 5917
16210	5503	CALL HYDPOG(3)
16220	C  TO DELETE VERTICAL LINE (55)
16230		KED=0
16240	59	TYPE 56,NAME,K,I,SVST
16250		JAB=JA
16260		SCORE=-1
16270		ACCEPT 89,INP
16300	8591	IF(I1.EQ.'Q')GO TO 591
16400	5917	DO 1313 L=1,14
16500	1313	IF(I1.EQ.LX(L))GO TO 2313
16600		GO TO 87
16700	C  'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF; 
16800	2313	IF(X22.NE.0)GO TO(884,883,883,5313,87,884,87,883,87,87,883
16900		1,15,883,883),L
17000	CP	GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
17100		GO TO(13,7555,14,5313,120,884,7555,883,7555,87,883,15,883
17200		1,59),L
17300	C               A  C   D   E   G   I   J    L   M   P   R   S  U(X
17400	C  HERE A=ALTER A GROUP, DE=DELETE A GROUP
17500	C  'DP'=DISPLAY OR HIDE WHICH STAVES.  D=DOWN N
17600	14	IF(I2-IE)883,13,884
17650	13	IF(I2.EQ.ID)GO TO 884
17675	C  'AD' = ADJUST STEMS TO MEET BEAMS (CODE# 19)
17700		IGO=1
17800		CALL GRED
17900		JFONT=0
18000		IF(JA.EQ.98)GO TO 5533
18100		KNT=0
18200		SCORE=0
18300		GO TO 653
18400	
18500	1591	I1=IL
18600	9591	FSCN=I1
18700		GO TO 5917
18800	2591	I1=IR
18900		GO TO 9591
19000	3591	I1=IU
19100		GO TO 9591
19200	4591	I1=ID
19300		GO TO 9591
19400	7591	I1=IXX
19500		GO TO 5591
19600	5912	I1=ICC
19700		GO TO 5591
19800	5913	I1=FSCN
19900		IF(FSCN.EQ.IL)GO TO 5914
20000		IF(FSCN.EQ.IR)GO TO 5914
20100	C NEXT FOR UP-DOWN
20200		UD=UD/2
20300		GO TO 5917
20400	5914	RL=RL/2
20500		GO TO 5917
20600	6591	I1=FSCN
20700		IF(I1.EQ.IL)GO TO 5916
20800		IF(I1.EQ.IR)GO TO 5916
20900		UD=UD*2
21000		GO TO 5917
21100	5916	RL=RL*2
21200		GO TO 5917
21300	
21400	
21410	C  'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF.
21412	C  SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
21500	15	DO 3313 L=1,6
21600	3313	IF(I2.EQ.LY(L))GO TO(312,3121,3121,3121,312,884),L
21700	C                               BL  A    B     D    E   T
21702		IF(I2.EQ.ICC)GO TO 884
21710		IF(I2.EQ.IP)GO TO 87
21720		IF(I2.EQ.'H')JFONT=1
21722		IF(I3.EQ.IXX)JFONT=0
21724		IF(I3.EQ.IP)JFONT=-1
21730	C  'SH'(=SHOW) IS SAME AS 44 1.  SHOWS TYPE FONTS ON DPY.
21732	C  'SHP' = SHOW ONLY AS 'PRIMATIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
21800		IF(I2.NE.IM)GO TO 5505
21900	C  ONLY FOR ST, SA, SB, SM, RS, S
22000	3121	IF(X22.NE.0)GO TO 5505
22100		SAVER=7
22200		CALL SAVIT
22300		GO TO 5505
22400	312	JA=55
22500		R2=RN(MEDIT+3)
22600	C  POSITION OF ITEM LOOKED AT.
22700		R3=55.
22800		GO TO 6531
22900	C  ABOVE FOR 'S'ET ALIGNMENT
23000	C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
23100	C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
23200	5313	K=-1
23300		DO 882 JA=3,10
23400	882	IF(INP(JA).NE.IBL)GO TO 884
23500		GO TO 883
23600	885	FORMAT(A2,21F)
23700	884	REREAD 885,K,R2,RJQ
23800		JA=55
23900		IF(I1.EQ.II)JA=22
23902		IF(I2.NE.ICC)GO TO 101
23904		CALL SCL
23906		GO TO 5505
23910	101	IF(I2.NE.ID)GO TO 988
23932		IF(I1.EQ.IA)JA=19
23955	C  'AD'just stems to beams.
24000	988	IF(I2.EQ.IT)JA=44
24010		IF(I2.EQ.'N')GO TO 188
24100		IF(I2.NE.IP)GO TO 6531
24200		IF(R2.GT.5)GO TO 1886
24300	C  GO BACK AND RESET ALL
24400		K=R2
24500		JA=0
24600	C  USE '5' FOR STAFF 0.
24700	888	IF(K.EQ.5)K=0
24800		DP(K)=-DP(K)
24900		JA=JA+1
25000		K=RJQ(JA)
25100		IF(K.EQ.0)GO TO 55
25200	C  JUMP OUT IF RJQ(JA)=0 OR 99
25300		IF(K.EQ.99)GO TO 85
25400	C*** 3/74  END WITH '99' TO MAKE DP RIGHT NOW!
25500		GO TO 888
25600	C  TO GET BACK ALL LINES TYPE 6+
25700	311	JA=0
25800		IGO=1
25900		ML=0
26000		IF(I2.NE.IL)GO TO 884
26100	1886	DO 2886 K=-3,4
26200	2886	DP(K)=1
26300		GO TO 85
26400	CP	IF(I1.NE.IP)GO TO 8851
26500	C PL RESETS 'DP'
26600	C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
26700	CP2311	CALL PLTCMD
26800	CP	IF(PLOTIT.EQ.0)GO TO 3005
26900	CP	I1=IP
27000	CP	PLOTIT=-1
27100	CP	GO TO 6531
27200	C  'PL' GOES TO 'PLOT COMMAND' ROUTINE
27300	
27400	881	IF(I1.GT.0)GO TO 87
27500	C   JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
27600	883	IF(I2.EQ.IS)GO TO 2
27700	C  TYPE 'RS' TO RESTART.
27800		IF(IX.EQ.I)GO TO 8834
27820		IF(I2.NE.IE)GO TO 8831
27840	C  CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
27850		IF(I1.NE.IR)GO TO 5505
27855		JA=144
27857	C  'READ' IS SAME AS 144
27860		GO TO 88
27900	8834	IF(I1.EQ.ICC)GO TO 72
28000	8831	IF(JA.NE.16)GO TO 8832
28100		IF(X22.EQ.0)GO TO 5505
28200	C  CAN'T MOVE LETTERS OR 'SCORE' ENTRIES UNLESS REALLY IN EDIT MODE!
28300	8832	CALL EDIT(JJA)
28400		IF(JA.NE.99)GO TO 6531
28500		CALL DELETE
28600	C  DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
28700		GO TO 425
28800	89	FORMAT(72A1)
28900	C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
29000	
29100	CC101	CALL SCL
29200	CC	GO TO 5505
29300	CC221	JFONT=R2
29400	C JA=44 IS FOR JFONT (DISPLAY FONT OUTLINES)-WIPED OUT BY '24' ETC.
29500	CC  OUT 3/1/76	GO TO 5505
29550	CC441	R2=R3
29575	441	RSET4=R3
29600	CC440	RSET4=R2
29700	C  SETS "SETUP" STAFF NUMBER
29800		GO TO 5505
29900	
30000	87	REREAD 1,JA,R2,RJQ
30100		IF(K)JA=55
30200	C   ED 47 -1 = 55 47 -1, ETC.
30300		IF(JA.EQ.101)GO TO 101
30400	CC	IF(JA.EQ.44)GO TO 221
30600	CC	IF(JA.EQ.14)GO TO 88
30700	C  IS THERE A BUG CONCERNING SAVIT AND 'SCORE'????
30800	CC	IF(JA.EQ.144)GO TO 88
30810	CC	IF(JA.EQ.444)GO TO 440
30820		IF(I1.EQ.'Z')GO TO 24
30822	C  'Z' = ZOOM  (OLD CODE# 24)
30855		IF(I2.EQ.IP)GO TO 441
30877	C  'SP' IS SAME AS 444
30890		IF(I1.EQ.IP)GO TO 33
30892	C  'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
30900		IF(JA.GT.0)SAVER=SAVER-1
31000		IF(X22.NE.0)GO TO 6531
31005		IF(SAVER)CALL SAVIT
31007	C  SAVES EVERY 7TH TIME AROUND
31010		IF(I1.NE.IT)GO TO 288 
31025	C NEXT FOR ALPHA TEXT ITEMS.  'T'=TYPE
31040		JA=16
31055		M=I
31070		CALL WORDS
31085		GO TO 8852
31100	288	IF(JA.EQ.0)GO TO 5505
31200	C  CATCHES ZEROS AND LOWER CASE LETTERS.
31450		GO TO 6531
31500	CC8833	IF(JA.EQ.14)GO TO 88
31600	CC	IF(JA.EQ.144)GO TO 88
31700	CC8833	IF(JA.NE.16)GO TO 6531
32200	
32300	CC188	R3=0
32400	CC88	SET4=R3
32500	C  *** THIS FEATURE CHNGD. 6/75***SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
32510	188	JA=14
32515		RMODE2=R3
32520	C  TYPE 'IN STF# MODE' ETC.  -- SAME AS 14 STF#.
32600	88	SCORE=0
32700		IF(JA.NE.14)GO TO 889
32800	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
32900		SAVER=-1
33000		RSTF=R2
33100		IF(R3)R3=0
33200		DO 1889 K=1,ITEM
33300		J=PWDS(K)
33400		IF(RN(J+1).NE.8)GO TO 1889
33500		IF(RN(J+2).EQ.R2)GO TO 890
33600	1889	CONTINUE
33700	C DIDN'T FIND THIS STAFF
33800		M=2000
33900		IGO=0
34000		JA=8
34050		R3=0
34100		GO TO 6531
34200	890	JA=14
34300		ITCHK=ITEM
34400		ICHK=I
34500		IDPY=ST2
34600	C ALL THIS FOR BACKUPS
34700	889	SPD=ST2
34800		JIT=ITEM
34900		ISC=I
35000		REND=0
35100	C   RETAINS ORIGINS OF SCORE SQUENCE
35200	9532	IF(REND.EQ.2)GO TO 889
35300	C  FOR READIN CONTINUATION.
35400		M=ISC
35500	9533	IF(JA.EQ.8)GO TO 890
35600		IF(REND)GO TO 9535
35700	C REND=0 GO,  -1=NORMAL END,  1=ABORTED.
35800		CALL SCMSS
35900		IF(REND.EQ.1)GO TO 9535
36000		IF(REND.NE.99)GO TO 9534
36100		I=ICHK
36200		ITEM=ITCHK
36300		ST2=IDPY
36400		CALL ACCPOG(1)
36500		CALL DPYOUT(1)
36600		GO TO 9535
36700	9534	ITEM=JIT
36800		J=M
36900	9536	ITEM=ITEM+1
37000		PWDS(ITEM)=J
37100		J=J+RN(J)+3
37200		IF(J.LT.I)GO TO 9536
37300		IF(IBEAM)GO TO 9537
37400		R13=0
37500		R2=RSTF
37600		JA=19
37700		J3=0
37800		CALL HOMER
37900	9537	ITEM=JIT
38000		ST2=SPD
38100		GO TO 8852
38200	9535	SCORE=-1
38400		IGO=-1
38500		JA=16
38600	C  FOR TRAP AT 'EDIT'
38700		GO TO 5505
38800	
38900	553	IF(SCORE)GO TO 6531
39000	653	KNT=KNT+1
39100	C   NUM OF ITEMS IN LIST
39200		R11=0
39300		R10=0
39400		R9=0
39500	64	JA=R(1,KNT)
39600	264	R2=R(2,KNT)
39700		IF(JA.NE.0)GO TO 550
39800	C  =0 MEANS NO MORE ITEMS.
39900		CALL DPYOUT(1)
40000		GO TO 1100
40100	
40200	5533	X22=0
40300		IGO=-1
40400		CALL DPYNEW
40500		GO TO 55
40600	
40700	550	DO 7531 K=1,6
40800	7531	RJQ(K)=R(K+2,KNT)
40900	6531	M=1
41000		EDX=-1
41100		IF(JA.EQ.222)GO TO 72
41200		IF(JA.EQ.2222)GO TO 73
41300		DO 5532 K=1,20
41400	5532	JQ(K)=RJQ(K)
41500	CC	J2=R2
41600	CP7542	IF(I1.EQ.IP)GO TO 590
41700	C  X22= ITEM# WHEN EDITING OR DELETING.
41800		IF(X22.NE.0)GO TO 5511
41900		IF(JA.GT.0)GO TO 155
42000		IF(R2.EQ.0)GO TO 5505
42100	C  FOR UP, DOWN, LEFT, RIGHT
42200		RJJ2=J2
42300		GO TO 6221
42400	C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
42500	CC155	IF(JA.EQ.24)GO TO 24
42600	155	IF(JA.EQ.22)GO TO 42  
42700		IF(JA.EQ.44)GO TO 44
42800	C  THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
42900		IF(JA.EQ.55)GO TO 554
43000	CC	IF(JA.EQ.333)GO TO 6333
44000		IF(JA.NE.19)GO TO 60
44100		CALL HOMER
46000		GO TO 8853
     

00100	33	IF(X22.EQ.0)GO TO 6333
00101	C  WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2.
00102		J2=R2
00200		TYPE 331,J2,RJJ(J2-2)
00300	C  TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
00400		GO TO 5505
00500	331	FORMAT(I,F15.5)
00600	
00700	24	IF(X22.NE.0)GO TO 5505
00750		JA=24
00800	C  CAN'T DO ZOOM WHILE IN EDIT MODE
00900		IGO=0
01000	CC	CALL HYDPOG(2)
01100	C  TO ERASE SPACING SCALE.
01200	CC	IF(X22.EQ.0)GO TO 23
01300	CC	R2=RHORZ(RN(MEDIT+3))
01400	CC	M=RN(MEDIT+2)
01500	CC	R4=RN(MEDIT+4)*RSTFAC(M)+STFF(M)
01600	CC	ITEM=ITEM-1
01700	C  PICKS UP POINT FROM CURSOR IN 'BOX'
01800	CC	CALL CLRCUR
01900	CC	X22=0
02000	CC	GO TO 241
02100	23	IF(R2.LT.100)GO TO 2410
02200		R5=AMOD(R2,100.)
02300		R2=(R2-R5)/100.
02400		R3=1000.*R5-500.
02500		R4=R2*50.
02600	C TYPE 24 200.5 FOR 1ST HALF OF DOUBLE, 301 FOR LAST THIRD OF TRIPLE
02700	2410	IF(R2.NE.0)GO TO 241
02800		IGO=-1
02900	243	R2=1.
03000	C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
03100	241	RSZ=.845*R2
03200		JCEN=R3*RSZ
03300		KCEN=R4*RSZ
03310	C  NEXT TO RECONSTITUTE SPACING SCALE.
03315		IF(R2.EQ.1)GO TO 3312
03320		R2=(R4-100.)/100.
03330		IF(R2.LT.-3)R2=-3
03340	C  WE DON'T WORRY IF IT'S TOO HIGH (YET).
03345	3312	R4=0
03350		CALL SCL
03400		R2=0
03500		R3=0
03600		R4=0
03700		LCEN=0
03800		MCEN=0
03900	CC	RJSZ=1.
04000	C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
04100		JFONT=0
04200	85	M=1
04300		I=PWDS(ITEM+1)
04400		ITEM=0
04500	8552	ST2=3
04600	8852	PLT=1
04700		EDX=0
04800		CALL ACCPOG(1)
04900		IF(JA.EQ.0)GO TO 6120
05000		IF(JA.NE.24)IGO=0
05100		GO TO 6120
05200	
05300	6333	CALL LISTP(LST)
05400		GO TO 5505
05500	
05600	172	CALL JUGGLE
05700		CALL CLRCUR
05800		CALL DPYNEW
05900		IF(JA.EQ.22)GO TO 424
06000	C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
06100		IF(ZERO)GO TO 55
06200		X22=ZERO
06300		ZERO=-1
06400		IF(JA.EQ.55)GO TO 554
06500		IF(JA.EQ.44)GO TO 44
06600		IF(KED.NE.0)GO TO 244
06700		GO TO 425
06800	
06900	C  55,POS  -- SETS UP ALIGNMENT
07000	554	CALL BOX(-1,R2,STFF)
07100		IF(J4.EQ.0)KED=-1
07200		RITEM=R4
07300	C  FOR 'ED POS., STF., CODE#'
07400		IF(J3.GT.4)KED=-2
07500		RLINE=R2
07600		R2=R3
07700		GO TO 45
07800	
07900	C  '22,0' EDITS LAST ITEM ENTERED
08000	42	REDIT=999.0
08100		IF(R2.NE.0)GO TO 242
08200		X22=ITEM
08300		GO TO 429
08400	44	KED=1	
08500		RITEM=R3
08600	C  'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>4 = ALL STAVES.
08700		IF(R2.GT.4)KED=2
08800	45	REDIT=R2
08900	C  THE STAFF #
09000		JED=1
09100	244	X=ITEM  
09200		IF(JED.GT.X)GO TO 444
09300		DO 144 K=JED,X
09400		L=PWDS(K)
09500		IF(KED.EQ.-2)GO TO 654
09600	C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
09700		IF(KED.EQ.2)GO TO 656
09800		IF(RN(L+2).NE.REDIT)GO TO 144
09900		IF(KED)GO TO 654
10000		IF(RITEM.EQ.0)GO TO 655
10100	656	IF(RITEM.NE.RN(L+1))GO TO 144
10200	655	IF(JA.NE.55)GO TO 344
10300	654	IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
10400	144	CONTINUE
10500	444	REDIT=999.
10600	C  NO MORE ON LINE
10700		R2=0
10800	C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
10900		GO TO 73
11000	344	JED=K+1
11100	C  FOR NEXT TIME AROUND
11200		X22=K
11300		GO TO 429
11400	C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE
11500	
11600	91	CALL ACCPOG(1)
11700		IF(I.EQ.IX)ITEM=ITEM-1
11800		GO TO 142
11900	242	IF(X22.GT.0)GO TO 5511
12000	142	IF(R2.NE.0)GO TO 424
12100		IF(REDIT.EQ.999)GO TO 1554
12200		IF(JA.GE.0)GO TO 244
12300	1554	X22=X22+1
12400		IF(JA)X22=X22-1+JA
12500		IF(X22.LT.1)X22=1
12600		GO TO 425
12700	427	FORMAT(1XA5/,2F6.0,F10.2,$)
12800	4271	FORMAT('+  (',I2,')',F7.2,$)
12900	
13000	C  FOR EDITING
13100	5511	IF(JA.EQ.55)GO TO 420
13200	220	IF(JA.NE.22)GO TO 720
13300	C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
13400		KED=0
13500		JED=0
13600		GO TO 72
13700	720	IF(JA.EQ.44)GO TO 420
13800	CC 3/76 	IF(JA.EQ.33)GO TO 33
13900	CC	IF(JA.EQ.24)GO TO 24
14000	C  FOR '24' WHILE IN EDIT MODE.  MAGS WITH CURSOR AS CENTER.
14100		IF(MOD(JA,100).GT.13)GO TO 5505
14110	CC	IF(MOD(JA,100).GT.13.OR.JA.EQ.1)GO TO 5505
14300	C  PARAM NUM TOO HIGH?
14400	C  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
14500	4221	IF(X22.EQ.0)GO TO 5517
14600		IF(R2.NE.0)GO TO 5517
14700	C  BACKS UP WHEN IN EDIT MODE.
14800	
14900		IF(JA.GT.0)GO TO 5518
15000		IF(I.EQ.IX)GO TO 91
15100		ZERO=X22+1
15200	C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
15300	72	IF(X22.EQ.0)GO TO 55
15400		IF(KED.EQ.0)REDIT=999.
15500	320	IF(I.NE.IX)GO TO 172
15600		ITEM=ITEM-1
15700	C  TO DELETE AN ITEM
15800	73	X22=0 
15900		CALL CLRCUR
16000		CALL DPYNEW
16100		IF(REDIT.EQ.999.)GO TO 428
16200		IF(JA.EQ.55)GO TO 554
16300		IF(JA.EQ.44)GO TO 44
16400	428	IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 55
16500	C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
16600	424	X22=R2
16700	425	IF(X22.GT.ITEM)GO TO 73
16800	C  LEAVES EDIT MODE.
16900	429	IX=I
17000		MEDIT=PWDS(X22)
17100		J=2
17200	426	Y=RN(MEDIT)+J
17300		CALL LOOP(0,Y,1,I,MEDIT,RN)
17400		JJA=RN(I+1)
17500		YED=Y-2
17600		L=I+2
17700		DO 422 K=1,11
17800		IF(K.GT.YED)GO TO 423
17900		RJJ(K)=RN(L+K)
18000		GO TO 422
18100	423	RJJ(K)=0
18200	422	CONTINUE
18300		RJJ2=RN(L)
18400		IF(IGO.GT.0)GO TO 4231
18500	C  NO BOX WHEN IN GROUP EDIT ROUTINE
18600		IBOX=I
18700		RBOX=RJJ2
18800		CALL BOX(IBOX,RBOX,STFF)
18900	4231	ITEM=ITEM+1
19000		ST2=WDS(ITEM)
19100		GO TO 55
19200	
19300	5517	IF(JA.EQ.0)GO TO 6221
19400	5518	X=100-JA
19500		IF(X)JA=JA/100
19600		IF(JA.LE.2)GO TO 7221
19700		IF(JA.GE.22)GO TO 55
19800		I1=JA-2
19900		IF(X)GO TO 224
20000		RJJ(I1)=R2
20100		GO TO 6222
20200	224	RJJ(I1)=RJJ(I1)+R2
20300		GO TO 6222
20400	
20500	7555	CALL MOVER
20600		IF(R2.EQ.99)GO TO 59
20700	CP	IF(R3.EQ.99)GO TO 5504
20800	C   99=BACKUP OUT OF MOVER ETC.
20900		IGO=0
21000		JFONT=0
21100	C  SO IT WON'T DO ALL FONT LOOKUPS.
21200	8853	IF(JJ2)GO TO 5505
21300		M=PWDS(JJ2)
21400		I=PWDS(ITEM+1)
21500		ITEM=JJ2-1
21600		ST2=WDS(JJ2)
21700	C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
21800		GO TO 8852
21900	
22000	CP8851	IF(I1.NE.IP)GO TO 85
22100	CP	GO TO 6531
22200	
22300	420	REDIT=0
22400	211	IF(R2.NE.0)GO TO 320
22500		IF(KED.GE.0)RLINE=RJ3
22600	CC	R3=RLINE
22700		RJ3=RLINE
22800	CC	X=0
22900		GO TO 6222
23000	C  FOR '55' ALIGNING
23100	7221	IF(X)GO TO 4223
23200		IF(JA.EQ.2)RJJ2=R2
23250		IF(JA.EQ.1)JJA=R2
23300		GO TO 6222
23400	4223	RJJ2=R2+RJJ2
23500	CC6222	IF(JQ(1).EQ.0)GO TO 6221
23600	C  ARRAYS NEED 2O LOCATIONS HERE.
23700	C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
23800	6222	DO 1222 K=1,20,2
23900		L=JQ(K)
24000	CC	IF(L.EQ.0)GO TO 5223
24100		IF(L.EQ.0)GO TO 6221
24200		JA=100-L
24300		IF(JA)L=L/100
24400	C  600 2  WILL ADD 2 TO PARAM 6.
24500		RD=RJQ(K+1)
24600		X=L-2
24700		IF(JA.GT.0)GO TO 223
24800		IF(L.EQ.2)GO TO 1223
24900		RD=RJJ(X)+RD
25000		GO TO 2223
25100	1223	RD=RJJ2+RD
25200	223	IF(L.LE.2)GO TO 3223
25300	2223	RJJ(X)=RD
25400		GO TO 1222
25500	3223	IF(L.EQ.2)RJJ2=RD
25550		IF(L.EQ.1)JJA=RD
25575	C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
25600	1222	CONTINUE
25700	C***  LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
25800	CC5223	R2=RJJ2
25900	6221	DO 5514 K=1,11
26000		RJQ(K)=RJJ(K)
26100	5514	JQ(K)=RJQ(K)
26200		R2=RJJ2
26300		JA=JJA
26400		ITEM=ITEM-1
26500		IF(ITEM)ITEM=0
26600		ST2=WDS(ITEM+1)
26700		I=PWDS(ITEM+1)
26800		CALL DPYNEW
     

00100	60	J2=R2
00200		RSTJ2=RSTFAC(J2)
00300	CL	RD=0
00400		IF(JA.NE.2)GO TO 163
00500	CJ	IF(R9.EQ.0)GO TO 163
00600		IF(R8.EQ.0)GO TO 163
00700		IF(R8.EQ.-1)GO TO 163
00800	C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
00900		K=ITEM
01000	C  ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
01100		IF(X22.NE.0)K=X22-1
01200		RD=1.75*RSTJ2
01300		L=PWDS(K+2)
01400		IF(RN(L+1).NE.4)GO TO 164
01500	C  GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
01600		IF(RN(L+2).NE.R2)GO TO 164
01700		RB=RN(L+3)
01800		L=PWDS(K)
01900	C  CHECK PREV. AND NEXT ITEM.  IF NOT BAR, DON'T TRY TO CENTER!
02000		IF(RN(L+1).NE.4)GO TO 164
02100		IF(RN(L+2).NE.R2)GO TO 164
02200	C  JUMP IF NOT ON SAME STAFF
02300		RA=RN(L+3)
02400		R3=RA+(RB-RA)/2-1.75*RSTJ2
02500	164	IF(PLT.EQ.0)GO TO 160 
02600		RN(PWDS(K+1)+3)=R3
02700	C  ******* A DANGEROUS PLACE.  KEEP TRACK OF THIS
02800		GO TO 5541
02900	
03000	163	IF(JA.EQ.16)GO TO 63
03100		IF(PLT.NE.0)GO TO 5541
03200		IF(JA.NE.8)GO TO 70
03300		IF(R9.NE.1)GO TO 70
03400		R9=RN(MEDIT+9)
03500		RD=R9
03600		IF(R9.NE.' ')TYPE 427,R9
03700		TYPE 21
03800		ACCEPT FA5,R9
03900		IF(R9.EQ.' ')R9=RD
04000	CC	IF(R9.EQ.'0')R9=0
04100	C  WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
04200	70	IF(JA.NE.11)GO TO 160
04300	C  ↑↑↑↑ WAS - TO 63
04400		IF(J10.NE.1)GO TO 62
04500		L=NJR
04600		TYPE 21
04700		ACCEPT FA5,NJR
04800	C   P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
04900		IF(NJR.EQ.LY(1))NJR=L
05000		LASTNM=NJR
05100	62	IF(NJR.EQ.0)NJR=LASTNM
05200	C  IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
05300		GO TO 160
05400	CC63	IF(JA.EQ.50)JA=16
05500	C  ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
05600	CL63	IF(R3.LT.1000)GO TO 66
05700	CL	RD=R3
05800	CL	IF(JA.EQ.5)R13=R3/1000.
05900	CL	CALL RNOTE(R3)
06000	C IF R3>1000 IT FINDS TRUE R3 THROUGH NOTE NUMB.
06100	CL66	IF(JA.NE.16)GO TO 160
06200	CX63	IF(JA.NE.16)GO TO 160
06300	C  USE P10≠0 TO LINK UP TEXT.
06400	CCZZZZZZ	IF(J10.EQ.0.OR.PLT.NE.0)GO TO 160
06500	63	RD=R5
06600		IF(RD.GE.100)RD=RD-100
06700	C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE.
06800		IF(J10.EQ.0)GO TO 162
06900		L=ITEM
07000		IF(X22.NE.0)L=X22-1
07100		IF(J10.EQ.1)GO TO 263
07200	C ↓↓↓↓ TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE.  "10 99"
07300		IF(J10.NE.99)GO TO 863
07400		X=PWDS(X22)+6
07500		DO 563 L=X,X+2
07600		RB=RN(L)
07700		K=RB
07800	C  CHECKS TO SEE WHICH FORMAT
07900	563	IF(K.NE.RB)GO TO 663
08000		GO TO 57
08100	663	DO 763 L=X,X+2
08200	763	RN(L)=RN(L)*100.
08300		GO TO 57
08400	
08500	C  NEXT FOR CENTERING TEXT.  P10>1
08700	863	RB=0
08800		X=PWDS(L+1)
08900	363	L=L+1
09000		K=PWDS(L)
09100		RB=RB+RN(K+9)
09200	C  ADD SPACE NEEDED
09300		K=PWDS(L+1)
09400		IF(RN(K+1).NE.16)GO TO 463
09500		IF(RN(K).EQ.8)GO TO 363
09600	C GO BACK IF MORE LETTERS TO COME
09700	463	R3=R10-(RB-3.4)*RD*RSTJ2/2.
09800	C  +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
09900		R10=0
10000		IF(RN(X).EQ.8)RN(X+10)=0
10100		RN(X+3)=R3
10200	C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
10300		GO TO 162
10400	263	K=PWDS(L)
10500		R3=RN(K+5)*RSTJ2*RN(K+9)+RN(K+3)
10600		R4=RN(K+4)
10700		R5=RN(K+5)
10800		R2=RN(K+2)
10900		J2=R2
11000		L=PWDS(L+1)
11100		DO 361 JJA=3,5
11200	361	RN(L+JJA)=RJQ(JJA-2)
11300		RN(L+2)=R2
11400	CCC	RN(PWDS(L+1)+3)=R3
11500	C  PUTS POS. BACK INTO RN ARRAY EVERY TIME.
11600	C  PUTS 13TH(+) LETTER IN RIGHT POS. 
11700	162	IF(PLT.NE.0)GO TO 5541
11800	CX160	IF(EDX.NE.0)GO TO 162
11900	CP	IF(I1.EQ.IP)GO TO 5541
12000	CX162	RJ3=R3
12100	160	RJ3=R3
12200		JJA=JA
12300		IF(R8.NE.0)GO TO 161
12400		IF(JA.EQ.1)R8=999.
12500	C  999=0 FOR STEM EXTENSIONS.
12600	CL161	CNT=1
12700	CL	DO 5543 K=1,9
12800	C  10/6/73 ABOVE WAS ,11
12900	CL	RA=RJQ(K)
13000	CL	IF(RA.NE.0)CNT=K
13100	CL5543	RJJ(K)=RA
13200	C  USES ONLY 10 PARAMETERS BEYOND JA, J2
13300	161	CALL MSSLUP
13400	CP2554	IF(PLT.NE.0)GO TO 5541
13500		IF(JA.EQ.6)CALL HOMER
13600		IF(JA.NE.13)GO TO 1261
13700		IF(J6.NE.0)R13=-1
13800	
13900	1261	IF(R13.EQ.0)GO TO 261
13950		RD=R11
14000		CALL HOMER
14050		R11=RD
14075	C  R11 GETS CHANGED IN 'HOMER'
14100		IF(JA.EQ.10)R3=R3+RSTJ2
14110		IF(JA.NE.9)GO TO 261
14120		IF(J5.GT.3)GO TO 261
14140		CALL NOZERO(R6)
14160		R3=R3+RSTJ2+2.*RSTJ2*R6
14200	C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
14300	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
14350	C  P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
14375	C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHRP,NAT)
14400	C **** FOR '0' EDITS ******
14500	CL261	RN(I)=CNT
14600	CL	RN(I+1)=JA
14700	CL	I=I+2
14800	CL	RN(I)=R2
14900	CL	IF(RD.NE.0)RN(I)=RD
15000	C TO SAVE NOTE NUMBS IN P2.
15100	CL	DO 4554 K=1,CNT
15200	CL4554	RN(I+K)=RJQ(K)
15300	CL3554	I=CNT+1+I
15400	261	CALL LUP2
15500	5541	IF(DP(J2))GO TO 57
15600	C*** 3/74  NEW DP SYSTEM
15700	C  WHAT ABOUT EDITS?*******
15800		POS=STFF(J2)
15900		RX3=R3
16000	C  SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
16100		J3=ROFF(RHORZ(R3))
16200	C  LINE IS DIVIDED INTO 200 POINTS.
16300		CALL CENTX
16400	C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
16500		R3=J3
16600		IF(JA.LE.2)GO TO 11
16700	551	GO TO(1,1,68,25,67, 625,116,125,11,69, 68,67),JA
16800		GO TO (116,81,80),JA-15
16900	C  FOR 16,17,18 (WORDS, KSIG, METER)
17000		IF(JA.EQ.99)GO TO 57
17100	C    FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
17200	
17300	222	I=PWDS(ITEM+1)
17400		GO TO 5505
17500	C  44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
17600	
17700	69	CALL MAKNUM(R5)
17800		GO TO 57
17900	
18000	68	CALL CLEFS
18100		GO TO 57
18200	
18300	67	CALL SLUR
18400		GO TO 57
18500	
18600	116	CALL ALPHA
18700		GO TO 57
18800	
18900	81	CALL KSIG
19000		GO TO 57
19100	
19200	80	CALL METER
19300		GO TO 57
19400	
19700	125	IF(R2.EQ.0)RMOV=R8
19710	625	CALL BMSTF
19720		GO TO 57
19725	C   BEAMS, STAFF LINES ****
19730	
19800	25	CALL ITMSUB
19900	C   BAR LINES, ETC.
20000		GO TO 57
20100	
20200	C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY; 
20300	120	IF(I.EQ.1)GO TO 1220
20400		IF(I2.NE.IM)GO TO 222
20500	C  'GM'=GET MORE
20600	1220	CALL FORMAT(NAME)
20700	C  NOW TYPE 'G NAME' OR 'GM NAME'
20800		IF(NAME.NE.IBL)GO TO 1221
20900	1225	TYPE 21
21000		ACCEPT FA5,NAME
21100		IF(NAME.EQ.'99')GO TO 5505
21200		IF(NAME.EQ.IBL)GO TO 2220
21300	1221	IF(LOOKF(NAME).EQ.0)GO TO 1225
21400	C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
21500	2220	JA=-1
21600	C  -1 IS FOR 8852+3
21700	CC3005	REWIND 21
21800	C  GUARDS AGAINST LOSSAGE!
21900	CP	PLOTIT=-1
22000	CP	IF(I1.NE.IG)PLOTIT=-2
22100	CC2005	IF(NAME.EQ.IBL)GO TO 2200
22200	CC	CALL IFILE(21,NAME)
22300	C  JUMP TO READ BIG FILES
22400	2200	J=ITEM+1
22500	CC2202	READ(21,END=2207),X,Y,
22600	CC	1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
22700	CC	1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF,RPOS
22800		IF(NAME.NE.IBL)GO TO 2207
22900		CALL GETFIL('TMP')
23000		GO TO 2202
23100	2207	CALL GETFIL(NAME)
23200	CC	CALL IFILE(21,NAME)
23300	C  LP IS START OF RN ARRAY THIS TIME
23400	2202	CALL FASTIN(RSTFAC,128)
23500		CALL FASTIN(PWDS(J),JJ2)
23600		CALL FASTIN(RN(I),IPOS)
23700		IF(LCNT.GT.1)CALL FASTIN(LIST,LCNT)
23800	C (K) BUG IN FORTRAN UNFORMATTED READ-WRITE. SOMETIMES LAST ITEMS WRONG.
23900	CC2207	ITEM=ITEM+X
24000		ITEM=ITEM+JJ2-2
24100		IF(I2.EQ.IM)GO TO 2203
24200	CC	I=Y
24300		I=IPOS
24400		IF(RSTF.EQ.0)GO TO 85
24500	C  (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER 
24600	CPPPPP   8851 IS NOW 85
24700	CC	READ(21,END=85),RSTFAC,STFF
24800	CC	IF(I1.EQ.IP)GO TO 6531
24900	CPPPPP   8851 IS NOW 85
25000	CC22222	READ(21,END=85),ST2,(ST(K),K=1,ST2+2),(WDS(K),K=1,ITEM+1)
25100		CALL FASTIN(ST,4250)
25200		CALL DPYNEW
25300		GO TO 5505
25400	
25500	2203	M=I-1
25600		DO 2204 K=J,J+JJ2-2
25700	2204	PWDS(K)=PWDS(K)+M
25800		GO TO 85
25900	CP121	IF(PLOTIT.EQ.0)GO TO 5504
26000	CP5121	CALL PLTSRT
26100		M=IX
26200	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
26300	CC	PLT=-1-J8
26400	CP	PLT=-1
26500	C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
26600	CC	M=I
26700	CC	I=I+M-1
26800	C M IS SET UP IN PLTSRT
26900	CP	CALL NOZERO(R2)
27000	CP	DIS=R2*1.24
27100	CP	IF(R3.EQ.0)R3=R2
27200	CP	RHT=R3*1.2
27300	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
27400	CP	BOT=-BOT*RHT
27500	CP	IF(TOP2.EQ.-999)GO TO 8121
27600	CP	BOT=BOT+TOP2
27700	CP	GO TO 9121
27800	CP8121	CALL PLOTS(K)
27900	CP	RNOMOV=0
28000	CP9121	IF(R7.EQ.0)R7=RMOV
28100	C RMOV HAS INCHES FROM P8 OF STAFF 0.
28200	CP	IF(RNOMOV.GT.1)BOT=RNOMOV
28300	CP	RNOMOV=R6+R7*200.*R3
28400	CC	RNOMOV=R6+R7*202.*R3
28500	CP	RMOV=0
28600	C  R6=1 FOR NO MOVE AT END.  R7=INCHES TO MOVE FOR NEW STAFF 0.
28700	C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
28800	C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE.  THEN
28900	C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
29000	CP	IF(J5.NE.0)GO TO 6120
29100	CP6121	CALL PLOT(0,BOT,-3)
29200	C  MOVES PLOTTER UP IF P5=0.
29300	
29400	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
29500	6120	IF(M.GE.I)GO TO 7120
29600		CALL RUNTHR(M)
29700	CF	CNT=RN(M)
29800	C  CLEARS INPUT ARRAY, USES ONLY 12 PARAMS.
29900	CF	DO 6220 K=CNT+1,10
30000	CF	JQ(K)=0
30100	CF6220	RJQ(K)=0
30200	CF	JA=RN(M+1)
30300	CF	M=M+2
30400	CF	R2=RN(M)
30500	CF	DO 9120 K=1,CNT
30600	CF	RJQ(K)=RN(M+K)
30700	CF9120	JQ(K)=RJQ(K)
30800	CF	M=CNT+M+1
30900		IF(EDX.LE.0)GO TO 60
31000		GO TO 5505
31100	
31200	7120	M=1
31300	CP	IF(EDX)GO TO 71201
31400		IF(PLT.EQ.1)EDX=-1
31500		PLT=0
31600		GO TO 5505
31700	CP71201	X=50*RHT
31800	CP	TOP=TOP*RHT+X
31900	CP	IF(RNOMOV.NE.0)TOP=0
32000	CP	IF(RNOMOV.GT.1)TOP=RNOMOV
32100	CP	CALL PLOT(0,TOP,3)
32200	CP	TOP2=TOP
32300	CP	GO TO 2
32400	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
32500	CC7121	CALL PLOT(0,TOP,3)
32600	C  MOVES PLOTTER UP
32700	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
32800	CC	TOP2=TOP
32900	CC	GO TO 2
33000	
33100	56	FORMAT(/1XA5,'  TYPE FOR ITEM #',I3,I,I6/)
33200	1	FORMAT(I,24F)
33300	21	FORMAT(' FILE NAME?  '$)
33400		END